{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Unicode;
{$WARN SYMBOL_PLATFORM OFF}

interface

uses Classes, Windows;

type
{ Search record used by FindFirstW, FindNextW, and FindCloseW }

  TSearchRecW = record
    Time: Integer;
    Size: Integer;
    Attr: Integer;
    Name: WideString;
    ExcludeAttr: Integer;
    FindHandle: THandle;
    FindData: TWin32FindDataW;
  end;

{ Unicode aware versions of equivalent classes from Classes unit }

  TFileStreamW = class(THandleStream)
  public
    constructor Create(const FileName: WideString; Mode: Word); overload;
    constructor Create(const FileName: WideString; Mode: Word; Rights: Cardinal); overload;
    destructor Destroy; override;
  end;


// These are unicode aware versions of equivalent functions from SysUtils unit

{ File management routines }
function FileOpenW(const FileName: WideString; Mode: LongWord): Integer;
function FileCreateW(const FileName: WideString): Integer; overload;
function FileCreateW(const FileName: WideString; Rights: Integer): Integer; overload;

{ File utility routines }
function RenameFileW(const OldName, NewName: WideString): Boolean;
function DeleteFileW(const FileName: WideString): Boolean;
function CopyFileW(const Source, Target: WideString; Overwrite: Boolean): Boolean;
function CopyDirectoryW(Source, Target: WideString; Overwrite: Boolean): Boolean;
function FileAgeW(const FileName: WideString): Integer;
function FileExistsW(const FileName: WideString): Boolean;
function DirectoryExistsW(const Directory: WideString): Boolean;
function ForceDirectoriesW(Dir: WideString): Boolean;
function CreateDirW(const Dir: WideString): Boolean;

{ File search routines }
function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
function FindNextW(var F: TSearchRecW): Integer;
procedure FindCloseW(var F: TSearchRecW);

{ File name routines }
function ParentFolderW(Folder: WideString): WideString;
function LastFolderW(Path: WideString): WideString;
function IsPathDelimiterW(const S: WideString; Index: Integer): Boolean;
function HasTrailingPathDelimiterW(const S: WideString): Boolean;
function IncludeTrailingPathDelimiterW(const S: WideString): WideString;
function ExcludeTrailingPathDelimiterW(const S: WideString): WideString;
function LastDelimiterW(const Delimiters, S: WideString): Integer;
function ExtractFilePathW(const FileName: WideString): WideString;
function ExtractFileNameW(const FileName: WideString): WideString;
function ExtractFileExtW(const FileName: WideString): WideString;
function ExtractFileCaptionW(const FileName: WideString): WideString;

{ Unicode to ansi conversion functions using UTF-8 encoding }
function EncodeWideString(Source: WideString): AnsiString;
function DecodeWideString(Source: AnsiString): WideString;

implementation

uses SysUtils, StrUtils, RTLConsts, JclUnicode;

{ File management routines }

function FileOpenW(const FileName: WideString; Mode: LongWord): Integer;
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := -1;
  if ((Mode and 3) <= fmOpenReadWrite) and
    (((Mode and $F0) shr 4) <= fmShareDenyNone) then
    Result := Integer(CreateFileW(PWideChar(FileName), AccessMode[Mode and 3],
      ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL, 0));
end;

function FileCreateW(const FileName: WideString): Integer;
begin
  Result := Integer(CreateFileW(PWideChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
end;

function FileCreateW(const FileName: WideString; Rights: Integer): Integer;
begin
  Result := FileCreateW(FileName);
end;

{ File utility routines }

function RenameFileW(const OldName, NewName: WideString): Boolean;
begin
  Result := MoveFileW(PWideChar(OldName), PWideChar(NewName));
end;

function DeleteFileW(const FileName: WideString): Boolean;
begin
  Result := Windows.DeleteFileW(PWideChar(FileName));
end;

function CopyFileW(const Source, Target: WideString; Overwrite: Boolean): Boolean;
var
  DestFile: WideString;
begin
  // If target is a directory then use same file name as source
  if HasTrailingPathDelimiterW(Target) then
    DestFile := IncludeTrailingPathDelimiterW(Target) + ExtractFileNameW(Source)
  else
    DestFile := Target;

  Result := Windows.CopyFileW(PWideChar(Source), PWideChar(DestFile), not Overwrite);
end;

function CopyDirectoryW(Source, Target: WideString; Overwrite: Boolean): Boolean;
var
  SR: TSearchRecW;
  DirList: array of WideString;
  DirCount, DirCapacity: Integer;
  Found, i: Integer;
begin
  // Ensure source and target directories have a trailing slash
  if (Source <> '') and (Source[Length(Source)] <> '\') then Source := Source + '\';
  if (Target <> '') and (Target[Length(Target)] <> '\') then Target := Target + '\';

  // Ensure target directory exists
  Result := ForceDirectoriesW(Target);
  if not Result then Exit;

  // Defer allocating directory list until required
  DirCount := 0;
  DirCapacity := 0;

  // Scan all files in this directory
  Found := FindFirstW(Source + '*.*', faAnyFile, SR);
  while Found = 0 do
  begin
    if (SR.Attr and faDirectory) <> 0 then
    begin
      if LeftStr(SR.Name, 1) <> '.' then
      begin
        // Make a note of this folder for checking later
        if DirCapacity = DirCount then
        begin
          Inc(DirCapacity, DirCapacity * 2 + 4);
          SetLength(DirList, DirCapacity);
        end;
        DirList[DirCount] := SR.Name;
        Inc(DirCount);
      end
    end
    else
    begin
      // Copy this file
      Result := CopyFileW(Source + SR.Name, Target + SR.Name, Overwrite);
      if not Result then Exit;
    end;

    // Keep looking
    Found := FindNextW(SR);
  end;
  FindCloseW(SR);

  // Scan the list of subdirectories recursively
  if DirCount > 0 then
    for i := 0 to Pred(DirCount) do
      CopyDirectoryW(Source + DirList[i], Target + DirList[i], Overwrite);
end;

function FileAgeW(const FileName: WideString): Integer;
var
  Handle: THandle;
  FindData: TWin32FindDataW;
  LocalFileTime: TFileTime;
begin
  Handle := FindFirstFileW(PWideChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    end;
  end;
  Result := -1;
end;

function FileExistsW(const FileName: WideString): Boolean;
begin
  Result := FileAgeW(FileName) <> -1;
end;

function DirectoryExistsW(const Directory: WideString): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributesW(PWideChar(Directory));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

function ForceDirectoriesW(Dir: WideString): Boolean;
begin
  Result := True;
  Dir := ExcludeTrailingPathDelimiterW(Dir);
  if (Length(Dir) < 3) or DirectoryExistsW(Dir)
    or (ExtractFilePathW(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
  Result := ForceDirectoriesW(ExtractFilePathW(Dir)) and CreateDirW(Dir);
end;

function CreateDirW(const Dir: WideString): Boolean;
begin
  Result := CreateDirectoryW(PWideChar(Dir), nil);
end;

{ File search routines }

function FindMatchingFileW(var F: TSearchRecW): Integer;
var
  LocalFileTime: TFileTime;
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not FindNextFileW(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi,
      LongRec(Time).Lo);
    Size := FindData.nFileSizeLow;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;

function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
const
  faSpecial = faHidden or faSysFile or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := FindMatchingFileW(F);
    if Result <> 0 then FindCloseW(F);
  end else
    Result := GetLastError;
end;

function FindNextW(var F: TSearchRecW): Integer;
begin
  if FindNextFileW(F.FindHandle, F.FindData) then
    Result := FindMatchingFileW(F) else
    Result := GetLastError;
end;

procedure FindCloseW(var F: TSearchRecW);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(F.FindHandle);
    F.FindHandle := INVALID_HANDLE_VALUE;
  end;
end;

{ File name routines }

function ParentFolderW(Folder: WideString): WideString;
var
  i: Integer;
begin
  // Remove trailing slash from filename
  Result := ExcludeTrailingPathDelimiterW(Folder);

  // Trim last folder part from path if found
  i := LastDelimiterW(PathDelim, Result);
  Result := Copy(Result, 1, i);
end;

function LastFolderW(Path: WideString): WideString;
var
  i: Integer;
begin
  // Remove trailing slash from filename
  Result := ExcludeTrailingPathDelimiterW(Path);

  // Trim last folder part from path if found
  i := LastDelimiterW(PathDelim, Result);
  Result := Copy(Result, i + 1, MaxInt);

  // Add trailing slash to filename
  if Result <> '' then Result := IncludeTrailingPathDelimiterW(Result);
end;

function IsPathDelimiterW(const S: WideString; Index: Integer): Boolean;
begin
  Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = PathDelim)
end;

function HasTrailingPathDelimiterW(const S: WideString): Boolean;
begin
  Result := IsPathDelimiterW(S, Length(S));
end;

function IncludeTrailingPathDelimiterW(const S: WideString): WideString;
begin
  Result := S;
  if not IsPathDelimiterW(Result, Length(Result)) then
    Result := Result + PathDelim;
end;

function ExcludeTrailingPathDelimiterW(const S: WideString): WideString;
begin
  Result := S;
  if IsPathDelimiterW(Result, Length(Result)) then
    SetLength(Result, Length(Result)-1);
end;

function LastDelimiterW(const Delimiters, S: WideString): Integer;
var
  P: PWideChar;
begin
  Result := Length(S);
  P := PWideChar(Delimiters);
  while Result > 0 do
  begin
    if (S[Result] <> #0) and (StrScanW(P, S[Result]) <> nil) then Exit;
    Dec(Result);
  end;
end;

function ExtractFilePathW(const FileName: WideString): WideString;
var
  i: Integer;
begin
  i := LastDelimiterW(PathDelim + DriveDelim, FileName);
  Result := Copy(FileName, 1, i);
end;

function ExtractFileNameW(const FileName: WideString): WideString;
var
  i: Integer;
begin
  i := LastDelimiterW(PathDelim + DriveDelim, FileName);
  Result := Copy(FileName, i + 1, MaxInt);
end;

function ExtractFileExtW(const FileName: WideString): WideString;
var
  i: Integer;
begin
  i := LastDelimiterW('.' + PathDelim + DriveDelim, FileName);
  if (i > 0) and (FileName[i] = '.') then
    Result := Copy(FileName, i, MaxInt) else
    Result := '';
end;

function ExtractFileCaptionW(const FileName: WideString): WideString;
var
  i: Integer;
begin
  // Extract everything from filename except the extension
  i := LastDelimiterW('.' + PathDelim + DriveDelim, FileName);
  if (i > 1) and (FileName[i] = '.') then
    Result := Copy(FileName, 1, i - 1) else
    Result := FileName;
end;

{ UTF-8 conversion functions }

function EncodeWideString(Source: WideString): AnsiString;
begin
  // There is a handy implementation for this in JclUnicode unit
  Result := WideStringToUTF8(Source);
end;

function DecodeWideString(Source: AnsiString): WideString;
begin
  // There is a handy implementation for this in JclUnicode unit
  Result := UTF8ToWideString(Source);
end;

{ TFileStreamW }

constructor TFileStreamW.Create(const FileName: WideString; Mode: Word);
begin
  Create(Filename, Mode, 0);
end;

constructor TFileStreamW.Create(const FileName: WideString; Mode: Word; Rights: Cardinal);
begin
  if Mode = fmCreate then
  begin
    inherited Create(FileCreateW(FileName, Rights));
    if FHandle < 0 then
      raise EFCreateError.CreateResFmt(@SFCreateError, [FileName]);
  end
  else
  begin
    inherited Create(FileOpenW(FileName, Mode));
    if FHandle < 0 then
      raise EFOpenError.CreateResFmt(@SFOpenError, [FileName]);
  end;
end;

destructor TFileStreamW.Destroy;
begin
  if FHandle >= 0 then FileClose(FHandle);
  inherited Destroy;
end;


end.
